COVID-19 Progression: Australian Data Only

library(tidyverse)
library(rlang)
library(lubridate)
library(scales)
library(ggrepel)
library(glue)
library(rvest)
library(pander)
library(plotly)
library(httr)
library(jsonlite)
library(reactable)
library(htmltools)
library(Rcpp)
panderOptions("big.mark", ",")
panderOptions("table.split.table", Inf)
panderOptions("table.style", "rmarkdown")
panderOptions("missing", "")
theme_set(theme_bw())

cppFunction(
  'NumericVector sma(NumericVector x, int n) {
    int m = x.size();
    NumericVector out(m);
    double ma_ = 0.0;
    
    for (int i = n - 1; i < m; i++) {
      ma_ = 0.0;
      for (int j = i - n + 1; j <= i; j++) {
          ma_ += x[j];
          out[i] = ma_ / n; 
      }
    }
    
    return out;
    
  }')

auStates <- c(
  ACT = "Australian Capital Territory",
  QLD = "Queensland",
  NSW = "New South Wales",
  VIC = "Victoria",
  SA = "South Australia",
  WA = "Western Australia",
  NT = "Northern Territory",
  TAS = "Tasmania",
  AUS = "All States"
)

ausPops <- tribble(
  ~State, ~Population,
  "New South Wales",    8167532,
  "Victoria", 6696670,
  "Queensland", 5176186,
  "Western Australia", 2663561,
  "South Australia", 1770375,
  "Tasmania", 540780,
  "Northern Territory", 246413,
  "Australian Capital Territory", 431380
) %>%
  bind_rows(
    tibble(
      State = "All States",
      Population = sum(.$Population)
    )
  )

Data Sources

data <- fromJSON("https://covidlive.com.au/covid-live.json") %>%
    as_tibble() %>%
    mutate(
      across(
        .cols = ends_with("CNT"), 
        .fns = as.numeric
      ),
      REPORT_DATE = ymd(REPORT_DATE),
      LAST_UPDATED_DATE = as_datetime(LAST_UPDATED_DATE, tz = Sys.timezone())
    )

dt <- data %>%
    dplyr::filter(
        CODE == "AUS", !is.na(LAST_UPDATED_DATE)
    ) %>%
    pull(REPORT_DATE) %>%
    max()

All Data was taken from COVID-Live which is itself taken from the federally reported numbers. Discrepancies between state and federal numbers are common and generally known, however, given that these are the official figures numbers are taken at face value. No manual effort has been undertaken to correct these as that is a potentially endless and overwhelming task. Delays updating individual fields can occur often, such that the reported data is periodically incomplete during the day.

All values are current as of 21:17, 03 Aug 2022

Australian State populations were taken from the ABS Website and were accurate on 1^st Jan 2022.

Latest Australian Data

Using an estimated population size of 25,692,897, the total percentage of the Australian population confirmed as having been infected at some point currently sits at 37.04%, or one person in every 3.

Active Cases (Official)

addSign <- function(x, .f = comma, .accuracy = 1) {
  out <- x
  out[is.na(x)] <- ""
  out[which(x > 0)] <- paste0("+", .f(x[which(x > 0)], accuracy = .accuracy))
  out[which(x <= 0)] <- .f(x[which(x <= 0)], accuracy = .accuracy)
  out
}
bar_chart <- function(label, width = "100%", height = "16px", fill = "#00bfc4", background = NULL) {
  bar <- div(style = list(background = fill, width = width, height = height))
  chart <- div(style = list(flexGrow = 1, marginLeft = "8px", background = background), bar)
  div(style = list(display = "flex", alignItems = "left"), label, chart)
}
bar_chart_pos_neg <- function(label, value, max_value = 1, height = "16px",
                              pos_fill = "#005ab5", neg_fill = "#dc3220") {
  neg_chart <- div(style = list(flex = "1 1 0"))
  pos_chart <- div(style = list(flex = "1 1 0"))
  width <- paste0(abs(value / max_value) * 100, "%")

  if (value < 0) {
    bar <- div(style = list(marginLeft = "8px", background = neg_fill, width = width, height = height))
    chart <- div(style = list(display = "flex", alignItems = "center", justifyContent = "flex-end"), label, bar)
    neg_chart <- tagAppendChild(neg_chart, chart)
  } else {
    bar <- div(style = list(marginRight = "8px", background = pos_fill, width = width, height = height))
    chart <- div(style = list(display = "flex", alignItems = "center"), bar, label)
    pos_chart <- tagAppendChild(pos_chart, chart)
  }

  div(style = list(display = "flex"), neg_chart, pos_chart)
}
fs <- "12px"
bar_style <- function(width = 1, fill = "#e6e6e6", height = "75%", align = c("left", "right"), color = NULL) {
  align <- match.arg(align)
  if (align == "left") {
    position <- paste0(width * 100, "%")
    image <- sprintf("linear-gradient(90deg, %1$s %2$s, transparent %2$s)", fill, position)
  } else {
    position <- paste0(100 - width * 100, "%")
    image <- sprintf("linear-gradient(90deg, transparent %1$s, %2$s %1$s)", position, fill)
  }
  list(
    backgroundImage = image,
    backgroundSize = paste("100%", height),
    backgroundRepeat = "no-repeat",
    backgroundPosition = "center",
    color = color,
    fontSize = fs
  )
}
hs <- list(fontWeight = "bold", fontSize = fs)
df <- data %>%
  dplyr::filter(REPORT_DATE == dt) %>%
  dplyr::mutate(
    CASE_CNT = ifelse(is.na(CASE_CNT), PREV_CASE_CNT, CASE_CNT),
    ACTIVE_CNT = ifelse(is.na(ACTIVE_CNT), PREV_ACTIVE_CNT, ACTIVE_CNT),
    `Daily Change` = case_when(
      is.na(NEW_CASE_CNT) ~ CASE_CNT - PREV_CASE_CNT,
      TRUE ~ NEW_CASE_CNT
    ),
    `% Change` = `Daily Change` / PREV_ACTIVE_CNT,
    State = case_when(
      CODE == "AUS" ~ "All States",
      TRUE ~ auStates[CODE]
    ),
    State = factor(State, levels = ausPops$State)
  ) %>%
  left_join(ausPops) %>% 
  mutate(
    CODE_UP = ifelse(is.na(LAST_UPDATED_DATE), paste0(CODE, "*"), CODE),
    Rate = 1e5 * ACTIVE_CNT / Population,
    `% Total` = CASE_CNT / Population,
    `% Active` = ACTIVE_CNT / CASE_CNT,
    PPI = 1e5/Rate
  ) %>% 
  dplyr::select(
    State = CODE_UP, CASE_CNT, `% Total`, `% Active`,
    ACTIVE_CNT, `Daily Change`, `% Change`, contains("Rate"), 
    PPI
  ) %>%
  dplyr::arrange(State) 
tbl <- df %>%
  dplyr::filter(State != "AUS") %>% 
  reactable(
    columns = list(
      State = colDef(footer = "Total", maxWidth = 65),
      CASE_CNT = colDef(
        name = "Total",
        cell = function(value) comma(value, 1),
        maxWidth = 100,
        footer = comma(
          dplyr::filter(df, State == "AUS")[["CASE_CNT"]]
        )
      ),
      `% Total` = colDef(
        name = "% of Population",
        cell = function(value) percent(value, 0.1),
        footer = percent(
          dplyr::filter(df, State == "AUS")[["% Total"]],
          0.1
        )
      ),
      `% Active` = colDef(
        name = "% Currently Active",
        format = colFormat(percent = TRUE, digits = 1),
        style = function(value) bar_style(width = value),
        maxWidth = 100,
        align = "right",
        footer = percent(
          dplyr::filter(df, State == "AUS")[["% Active"]],
          0.1
        )
      ),
      ACTIVE_CNT = colDef(
        name = "Total",
        cell = function(value) comma(value, 1),
        maxWidth = 100,
        footer = comma(
          dplyr::filter(df, State == "AUS")[["ACTIVE_CNT"]]
        )
      ),
      `Daily Change` = colDef(
        cell = function(value) addSign(value),
        style = function(value) {
            color <- case_when(
              is.na(value) ~ "white",
              value > 0 ~ "#e00000",
              value < 0 ~ "#008000",
              TRUE ~ "black"
            )
            wt <- ifelse(value == 0, 400, 600)
            list(fontWeight = wt, color = color, fontSize = fs)
        },
        footer = addSign(
          dplyr::filter(df, State == "AUS")[["Daily Change"]] 
        )
      ),
      `% Change` = colDef(
        cell = function(value) addSign(value, percent, 1),
        maxWidth = 90,
        style = function(value) {
            color <- case_when(
              is.na(value) ~ "white",
              value > 0 ~ "#e00000",
              value < 0 ~ "#008000",
              TRUE ~ "black"
            )
            wt <- ifelse(value == 0, 400, 600)
            list(fontWeight = wt, color = color, fontSize = fs)
        },
        footer = addSign(
          dplyr::filter(df, State == "AUS")[["% Change"]],
          percent, 1
        )
      ),
      Rate = colDef(
        name = "Active Cases per 100,000",
        format = colFormat(digits = 0, separators = TRUE),
        style = function(value) bar_style(width = 0.5*value/max(df$Rate)),
        maxWidth = 90,
        align = "right",
        # cell = function(value) comma(value, 1),
        footer = comma(dplyr::filter(df, State == "AUS")[["Rate"]], 1)
      ),
      PPI = colDef(
        name = "People Per Active Case",
        cell = function(value) comma(value, 1),
        maxWidth = 90,
        footer = comma(dplyr::filter(df, State == "AUS")[["PPI"]], 1)
      )
    ),
    columnGroups = list(
      colGroup(
        name = "Cumulative Cases", columns = c("CASE_CNT", "% Total"),
        headerStyle = hs
      ),
      colGroup(
        name = "Active Cases", 
        columns = c("% Active", "ACTIVE_CNT", "Daily Change", "% Change"),
        headerStyle = hs
      ),
      colGroup(
        name = "Infection Rates", columns = c("Rate", "PPI"),
        headerStyle = hs
      )
    ),
    defaultColDef = colDef(
      headerStyle = hs, footerStyle = hs, style = list(fontSize = fs)
    )
  )
cp <- glue(
  "% Active indicates how many of the total cases are currently active. ",
  "Numbers are as reported by the States, which is known to be subject to changing methodologies at various points. ",
  "Importantly, given problems with testing in many states, the number of ",
  "active cases will be an underestimate. ",
  "States which are yet to report daily numbers are highlighted with an asterisk."
)
div(class = "active-cases",
  div(class = "active-cases-header",
    h2(class = "active-cases-title", "Summary of Active Infections"),
    cp
  ),
  tbl
)

Summary of Active Infections

% Active indicates how many of the total cases are currently active. Numbers are as reported by the States, which is known to be subject to changing methodologies at various points. Importantly, given problems with testing in many states, the number of active cases will be an underestimate. States which are yet to report daily numbers are highlighted with an asterisk.

Hospitalisations

hosp_off <- 7
df <- data %>%
  dplyr::filter(REPORT_DATE == dt) %>%
  dplyr::mutate(
    MED_HOSP_CNT = ifelse(is.na(MED_HOSP_CNT), PREV_MED_HOSP_CNT, MED_HOSP_CNT),
    MED_ICU_CNT = ifelse(is.na(MED_ICU_CNT), PREV_MED_ICU_CNT, MED_ICU_CNT),
    MED_VENT_CNT = ifelse(is.na(MED_VENT_CNT), PREV_MED_VENT_CNT, MED_VENT_CNT),
    State = case_when(
      CODE == "AUS" ~ "All States",
      TRUE ~ auStates[CODE]
    ),
    State = factor(State, levels = ausPops$State),
    CODE_UP = ifelse(is.na(LAST_UPDATED_DATE), paste0(CODE, "*"), CODE)
  ) %>%
  left_join(ausPops, by = "State") %>% 
  dplyr::select(
    CODE, CODE_UP, State, Population,
    contains("HOSP"), contains("ICU"), contains("VENT")
  ) %>% 
  left_join(
    dplyr::filter(data, REPORT_DATE == dt - hosp_off + 1) %>% 
      dplyr::select(CODE, ACTIVE_CNT),
    by = "CODE"
  ) %>% 
  mutate(
    change_hosp = MED_HOSP_CNT - PREV_MED_HOSP_CNT,
    perc_change_hosp = change_hosp / PREV_MED_HOSP_CNT,
    total_perc_hosp = MED_HOSP_CNT / ACTIVE_CNT,
    change_icu = MED_ICU_CNT - PREV_MED_ICU_CNT,
    perc_change_icu = change_icu / PREV_MED_ICU_CNT,
    # perc_hosp_icu = MED_ICU_CNT / MED_HOSP_CNT,
    perc_hosp_icu = MED_ICU_CNT / PREV_MED_HOSP_CNT,
    change_vent = MED_VENT_CNT - PREV_MED_VENT_CNT,
    perc_change_vent = change_vent / PREV_MED_VENT_CNT,
    # perc_hosp_vent = MED_VENT_CNT / MED_HOSP_CNT,
    perc_hosp_vent = MED_VENT_CNT / PREV_MED_HOSP_CNT,
    across(
      contains("perc"), function(x) {
        x[is.nan(x)] <- 0
        x[is.infinite(x)] <- NA_real_
        x
      }
    )
  ) %>% 
  dplyr::select(
    State = CODE_UP, hospitalised = MED_HOSP_CNT,
    ends_with("hosp"), contains("icu"), contains("vent"),
    -starts_with("PREV")
  ) %>% 
  arrange(State) %>% 
  split(f = .$State == "AUS") %>% 
  setNames(c("states", "national"))
tbl <- df$states %>% 
  reactable(
    columns = list(
      State = colDef(footer = "Total", maxWidth = 60),
      hospitalised = colDef(
        name = "Total",
        cell = function(value) comma(value, 1),
        maxWidth = 80,
        footer = comma(df$national$hospitalised)
      ),
      change_hosp = colDef(
        name = "Change",
          cell = function(value) addSign(value),
          style = function(value) {
            color <- case_when(
              is.na(value) ~ "white",
              value > 0 ~ "#e00000",
              value < 0 ~ "#008000",
              TRUE ~ "black"
            )
            wt <- ifelse(value == 0, 400, 600)
            list(fontWeight = wt, color = color, fontSize = fs)
          },
        maxWidth = 80,
        footer = addSign(df$national$change_hosp)
      ),
      perc_change_hosp = colDef(
        name = "% Change",
        maxWidth = 80,
        cell = function(value) percent(value, 0.1),
        style = function(value) {
          color <- case_when(
            is.na(value) ~ "white",
            value > 0 ~ "#e00000",
            value < 0 ~ "#008000",
            TRUE ~ "black"
          )
          wt <- ifelse(value == 0, 400, 600)
          list(fontWeight = wt, color = color, fontSize = fs)
        },
        footer = percent(df$national$perc_change_hosp, 0.1)
      ),
      total_perc_hosp = colDef(
        name = "% Cases (Offset)",
        maxWidth = 80,
        format = colFormat(digits = 1, percent = TRUE),
        style = function(value) bar_style(width = value , fill = "#C53270"),
        align = "right",
        footer = percent(df$national$perc_hosp_vent, 0.1)
      ),
      MED_ICU_CNT = colDef(
        name = "Total",
        maxWidth = 60,
        cell = function(value) comma(value, 1),
        footer = comma(df$national$MED_ICU_CNT)
      ),
      change_icu = colDef(
        name = "Change",
        maxWidth = 80,
        cell = function(value) addSign(value),
        style = function(value) {
          color <- case_when(
            is.na(value) ~ "white",
            value > 0 ~ "#e00000",
            value < 0 ~ "#008000",
            TRUE ~ "black"
          )
          wt <- ifelse(value == 0, 400, 600)
          list(fontWeight = wt, color = color, fontSize = fs)
        },
        footer = addSign(df$national$change_icu)
      ),
      perc_change_icu = colDef(
        name = "% Change",
        maxWidth = 80,
        cell = function(value) percent(value, 0.1),
        style = function(value) {
          color <- case_when(
            is.na(value) ~ "white",
            value > 0 ~ "#e00000",
            value < 0 ~ "#008000",
            TRUE ~ "black"
          )
          wt <- ifelse(value == 0, 400, 600)
          list(fontWeight = wt, color = color, fontSize = fs)
        },
        footer = percent(df$national$perc_change_icu, 0.1)
      ),
      perc_hosp_icu = colDef(
        name = "% Of Hosp.",
        maxWidth = 75,
        format = colFormat(digits = 1, percent = TRUE),
        style = function(value) bar_style(width = value*2, fill = "#F69422"),
        align = "right",
        footer = percent(df$national$perc_hosp_icu, 0.1)
      ),
      MED_VENT_CNT = colDef(
        name = "Total",
        maxWidth = 70,
        cell = function(value) comma(value, 1),
        footer = comma(df$national$MED_VENT_CNT)
      ),
      change_vent = colDef(
        name = "Change",
        maxWidth = 80,
        cell = function(value) addSign(value),
        style = function(value) {
          color <- case_when(
            is.na(value) ~ "white",
            value > 0 ~ "#e00000",
            value < 0 ~ "#008000",
            TRUE ~ "black"
          )
          wt <- ifelse(value == 0, 400, 600)
          list(fontWeight = wt, color = color, fontSize = fs)
        },
        footer = addSign(df$national$change_vent)
      ),
      perc_change_vent = colDef(
        name = "% Change",
        maxWidth = 80,
        cell = function(value) percent(value, 0.1),
        style = function(value) {
          color <- case_when(
            is.na(value) ~ "white",
            value > 0 ~ "#e00000",
            value < 0 ~ "#008000",
            TRUE ~ "black"
          )
          wt <- ifelse(value == 0, 400, 600)
          list(fontWeight = wt, color = color, fontSize = fs)
        },
        footer = percent(df$national$perc_change_vent, 0.1)
      ),
      perc_hosp_vent = colDef(
        name = "% Of Hosp.",
        maxWidth = 75,
        format = colFormat(digits = 1, percent = TRUE),
        style = function(value) bar_style(width = value *2, fill = "#FFFE9E"),
        align = "right",
        footer = percent(df$national$perc_hosp_vent, 0.1)
      )
    ),
    columnGroups = list(
      colGroup(
        name = "Hospitalised", columns = str_subset(colnames(df$states), "(^hosp|hosp$)"), 
        headerStyle = hs
      ),
      colGroup(
        name = "ICU", columns = str_subset(colnames(df$states), "ICU|icu"),
        headerStyle = hs
      ),
      colGroup(
        name = "Ventilated", str_subset(colnames(df$states), "VENT|vent"),
        headerStyle = hs
      )
    ),
    defaultColDef = colDef(
      footerStyle = hs, headerStyle = hs, style = list(fontSize = fs)
    )
  )
cp <- glue(
  "The % Cases Hospitalised column uses active cases with a {hosp_off} day ", 
  "offset and as such is a crude estimate. This is confounded by the ", 
  "difference in lag between exposure and hospitalisation for each strain. ",
  "The % of currently hospitlised cases which are in ICU or being ventilated ",
  "is also given, using a 1-day offset. ",
  "Some states do not report Ventilation numbers. ",
  "States which are yet to report are indicated with an asterisk. "
)
div(class = "hospitalisations",
    div(class = "hospitalisations-header",
        h2(class = "hospitalisations-title", "Summary of hospitalisations"),
        cp
    ),
    tbl
)

Summary of hospitalisations

The % Cases Hospitalised column uses active cases with a 7 day offset and as such is a crude estimate. This is confounded by the difference in lag between exposure and hospitalisation for each strain. The % of currently hospitlised cases which are in ICU or being ventilated is also given, using a 1-day offset. Some states do not report Ventilation numbers. States which are yet to report are indicated with an asterisk.

Fatalities

death_off <- 21
df <- data %>% 
  dplyr::filter(REPORT_DATE == dt) %>%
  dplyr::mutate(
    State = case_when(
      CODE == "AUS" ~ "All States",
      TRUE ~ auStates[CODE]
    ),
    State = factor(State, levels = ausPops$State),
    CODE_UP = ifelse(is.na(LAST_UPDATED_DATE), paste0(CODE, "*"), CODE),
    CASE_CNT = ifelse(is.na(CASE_CNT), PREV_CASE_CNT, CASE_CNT),
    DEATH_CNT = ifelse(is.na(DEATH_CNT), PREV_DEATH_CNT, DEATH_CNT),
  ) %>%
  left_join(ausPops, by = "State") %>% 
  dplyr::select(CODE, CODE_UP, State, contains("DEATH"), `Total Cases` = CASE_CNT) %>% 
  left_join(
    data %>% 
      dplyr::filter(REPORT_DATE == dt - death_off + 1) %>% 
      dplyr::select(CODE, CASE_CNT)
  ) %>% 
  mutate(
    `Daily Fatalities` = DEATH_CNT - PREV_DEATH_CNT,
    `Fatality Rate` = DEATH_CNT / CASE_CNT
  ) %>% 
  dplyr::select(
    State = CODE_UP, `Total Cases`, `Total Fatalities` = DEATH_CNT, contains("Fatal")
  ) %>% 
  split(.$State == "AUS") %>% 
  setNames(c("states", "national"))
tbl <- df$states %>% 
  reactable(
    columns = list(
      State = colDef(maxWidth = 80, footer = "Total"),
      `Total Cases` = colDef(
        format = colFormat(separators = TRUE),
        footer = comma(df$national$`Total Cases`)
      ),
      `Total Fatalities` = colDef(
        format = colFormat(separators = TRUE),
        footer = comma(df$national$`Total Fatalities`)
      ),
      `Daily Fatalities` = colDef(
        format = colFormat(separators = TRUE),
        cell = function(value) addSign(value),
        style = function(value) {
          color <- case_when(
            is.na(value) ~ "white",
            value > 0 ~ "#e00000",
            value < 0 ~ "#008000",
            TRUE ~ "black"
          )
          wt <- ifelse(value == 0, 400, 600)
          list(fontWeight = wt, color = color, fontSize = fs)
        },
        footer = comma(df$national$`Daily Fatalities`)
      ),
      `Fatality Rate` = colDef(
        format = colFormat(percent = TRUE, digits = 1),
        style = function(value) bar_style(width = 3*value),
        footer = percent(df$national[["Fatality Rate"]], 0.1)
      )
    ),
    defaultColDef = colDef(footerStyle = hs, headerStyle = hs, style = list(fontSize = fs))
  )
cp <- glue(
  "Summary of fatalities since the beginning of the pandemic. ", 
  "The fatality rate is calculated using the total cases offset by {death_off} days."
)
div(class = "fatalities",
    div(class = "fatalities-header",
        h2(class = "fatalities-title", "Summary of Fatalities"),
        cp
    ),
    tbl
)

Summary of Fatalities

Summary of fatalities since the beginning of the pandemic. The fatality rate is calculated using the total cases offset by 21 days.

Plot of Current Australian Values

momentum_df <- data %>% 
  dplyr::filter(REPORT_DATE <= dt, CASE_CNT > 0) %>% 
  arrange(CODE, REPORT_DATE) %>% 
  mutate(
    `Daily Fatalities` = DEATH_CNT - PREV_DEATH_CNT,
    `Daily Fatalities` = ifelse(is.na(`Daily Fatalities`), 0, `Daily Fatalities`),
    State = case_when(
      CODE == "AUS" ~ "All States",
      TRUE ~ auStates[CODE]
    ),
    State = factor(State, levels = ausPops$State)
  ) %>%
  # dplyr::select(REPORT_DATE, CODE, DEATH_CNT, CASE_CNT) %>% 
  group_by(CODE) %>% 
  mutate(
    weekly_change = log2(NEW_CASE_CNT / lag(NEW_CASE_CNT, 7)),
    short_ma = round(sma(weekly_change, 3), 2),
    long_ma = round(sma(weekly_change, 7), 2)
  ) %>% 
  ungroup() %>%
  dplyr::rename(Date = REPORT_DATE) %>% 
  mutate(
    Status = case_when(
      short_ma >= long_ma & long_ma > 0 ~ "Wave Underway",
      short_ma < long_ma & long_ma > 0 ~ "Momentum Slowing",
      short_ma <= 0 & long_ma <= 0 ~ "Wave Receding",
      short_ma > long_ma & short_ma > 0 & long_ma <= 0 ~ "Potential Wave Forming"
    )
  )

Active Infections

plotly::ggplotly(
  data %>% 
    arrange(CODE, REPORT_DATE) %>% 
    group_by(CODE) %>% 
    mutate(
      active = sma(NEW_CASE_CNT, 7)*7
    ) %>% 
    ungroup() %>% 
    arrange(desc(REPORT_DATE)) %>% 
    dplyr::mutate(
      State = case_when(
        CODE == "AUS" ~ "All States",
        TRUE ~ auStates[CODE]
      ),
      State = factor(State, levels = ausPops$State)
    ) %>% 
    left_join(ausPops) %>% 
    mutate(
      State = factor(State, levels = ausPops$State),
      `% Active` = percent(active / Population, 0.01),
      Active = comma(active, 1)
    ) %>% 
    dplyr::rename(Date = REPORT_DATE) %>% 
    ggplot(
      aes(label = `% Active`, key = Active, group = State)
    ) +
    geom_line(
      aes(Date, active / Population, colour = State)
    ) +
    coord_cartesian(xlim = c(dt - .5*365, dt)) +
    scale_y_continuous(labels = percent) +
    scale_color_manual(
      values = c(hcl.colors(length(ausPops$State) - 1, "Dark 3"), "black")
    ) +
    labs(
      x = "Date", y = "% Of Population Currently Infected"
    ),
  tooltip = c("State", "Date", "% Active", "Active")
) %>%
  plotly::style(visible = "legendonly", traces = c(6:9))

Plot of estimated active infections against time for the last year. Active infections are estimated as the sum of all new cases over a 7-day period. Double-click on a state in the legend to only see that state, or single-click individually to add or remove.

7 Day Totals

terms <- tribble(
  ~State, ~Start, ~End,
  "New South Wales", "2022-02-04", "2022-04-08",
  "New South Wales", "2022-04-26", "2022-07-01",
  "New South Wales", "2022-07-18", "2022-09-23",
  "Queensland", "2022-02-07", "2022-04-01",
  "Queensland", "2022-04-19", "2022-06-24",
  "Queensland", "2022-07-11", "2022-09-16",
  "Victoria", "2022-01-31", "2022-04-08",
  "Victoria", "2022-04-26", "2022-06-24",
  "Victoria", "2022-07-13", "2022-09-18",
  "Western Australia", "2022-01-31", "2022-04-08",
  "Western Australia", "2022-04-26", "2022-07-01",
  "Western Australia", "2022-07-18", "2022-09-23",
  "South Australia", "2022-01-31", "2022-04-14",
  "South Australia", "2022-05-02", "2022-07-08",
  "South Australia", "2022-07-25", "2022-09-30",
  "Tasmania", "2022-02-09", "2022-04-14",
  "Tasmania", "2022-05-02","2022-07-08",
  "Tasmania", "2022-07-26","2022-09-30",
  "Northern Territory", "2022-01-31", "2022-04-08",
  "Northern Territory", "2022-04-19", "2022-06-24",
  "Northern Territory", "2022-07-19", "2022-09-23",
  "Australian Capital Territory", "2022-01-31", "2022-04-08",
  "Australian Capital Territory", "2022-04-26", "2022-07-01",
  "Australian Capital Territory", "2022-07-18", "2022-09-23"
) %>% 
  mutate(
    State = factor(State, levels = ausPops$State),
    Start = ymd(Start),
    End = ymd(End)
  ) 
masks <- tribble(
  ~State, ~Date,
  "Victoria", "2022-02-21",
  "New South Wales", "2022-02-28",
  "Queensland", "2022-03-04",
  "South Australia", "2022-04-14",
  "Tasmania", "2022-03-11",
  "Northern Territory", "2022-03-06",
  "Australian Capital Territory", "2022-02-25",
  "Western Australia", "2022-04-29"
) %>% 
   mutate(
    State = factor(State, levels = ausPops$State),
    Date = ymd(Date)
   )
data %>% 
  arrange(CODE, REPORT_DATE) %>%
  group_by(CODE) %>% 
  mutate(
    NEW_CASE_CNT = case_when(
      is.na(NEW_CASE_CNT) ~ 0,
      TRUE ~ NEW_CASE_CNT
    ),
    active = sma(NEW_CASE_CNT, 7)*7
  ) %>% 
  ungroup() %>% 
  arrange(desc(REPORT_DATE)) %>% 
  dplyr::mutate(
    State = case_when(
      CODE == "AUS" ~ "All States",
      TRUE ~ auStates[CODE]
    ),
    State = factor(State, levels = ausPops$State)
  ) %>% 
  left_join(ausPops) %>% 
  mutate(
    State = factor(State, levels = ausPops$State),
    `% Active` = percent(active / Population, 0.01),
    Active = comma(active, 1)
  ) %>% 
  dplyr::rename(Date = REPORT_DATE) %>% 
  dplyr::filter(Date <= dt) %>% 
  ggplot(
    aes(label = `% Active`, key = Active, group = State)
  ) +
  geom_line(
    aes(Date, active, colour = State)
  ) +
  geom_point(
    aes(x = Date, y = active),
    data = . %>% 
      inner_join(terms, by = c("State" = "State", "Date" = "Start")),
    shape = 17, colour = "darkgreen", size = 2
  ) +
  geom_point(
    aes(x = Date, y = active),
    data = . %>% 
      inner_join(terms, by = c("State" = "State", "Date" = "End")),
    shape = 19, colour = "red", size = 2
  ) +
  geom_vline(
    aes(xintercept = Date, colour = State), data = masks, inherit.aes = FALSE,
    linetype = 2, show.legend = FALSE
  ) +
  facet_wrap(~State, scales = "free_y") +
  coord_cartesian(xlim = c(dt - .5*365, dt)) +
  scale_y_continuous(labels = comma) +
  scale_color_manual(
    values = c(hcl.colors(length(ausPops$State) - 1, "Dark 3"), "black")
  ) +
  labs(
    x = "Date", y = "Total Infected Over 7 Day Period"
  ) +
  theme(legend.position = "none")

Cumulative infections over 7 days, separated by state, including the day mask restrictions were lifted (dashed lines) and school term dates, with commencement indicated as the up-pointing triangle and term end as the downward pointing triangle.

Daily Cases

plotly::ggplotly(
  data %>% 
    dplyr::filter(REPORT_DATE <= dt, CASE_CNT > 0) %>% 
    arrange(CODE, REPORT_DATE) %>% 
    mutate(NEW_CASE_CNT = ifelse(is.na(NEW_CASE_CNT), 0, NEW_CASE_CNT)) %>%
    dplyr::select(REPORT_DATE, CODE, NEW_CASE_CNT, CASE_CNT) %>% 
    group_by(CODE) %>% 
    mutate(
      MA7 = sma(NEW_CASE_CNT, 7),
      State = case_when(
        CODE == "AUS" ~ "All States",
        TRUE ~ auStates[CODE]
      ),
      State = factor(State, levels = ausPops$State)
    ) %>% 
    ungroup() %>%
    mutate(MA7 = round(MA7, 2)) %>% 
    dplyr::rename(
      Date = REPORT_DATE, `New Cases` = NEW_CASE_CNT, `7 Day Average` = MA7
    ) %>% 
    ggplot(aes(Date, colour = State)) + 
    geom_point(aes(y = `New Cases`), alpha = 0.5, colour = "grey", size = 1/2) +
    geom_segment(
      aes(xend = Date, y = 0, yend = `New Cases`),
      colour = "grey", alpha = 0.5
    ) +
    geom_line(aes(y = `7 Day Average`)) +
    facet_wrap(~State, scales = "free_y", ncol = 1) +
    coord_cartesian(xlim = c(dt - 365/4, dt)) +
    scale_color_manual(
      values = c(hcl.colors(length(ausPops$State) - 1, "Dark 3"), "black")
    ) +
    labs(x = "Date", y = "Daily Cases") +
    theme(legend.position = "none")
)

Plot of daily new cases. Coloured lines represent 7 day averages.

Hospitalisations

plotly::ggplotly(
  data %>% 
    dplyr::filter(REPORT_DATE <= dt, CASE_CNT > 0) %>% 
    arrange(CODE, REPORT_DATE) %>% 
    mutate(MED_HOSP_CNT = ifelse(is.na(MED_HOSP_CNT), 0, MED_HOSP_CNT)) %>%
    dplyr::select(REPORT_DATE, CODE, MED_HOSP_CNT, CASE_CNT) %>% 
    group_by(CODE) %>% 
    mutate(
      MA7 = sma(MED_HOSP_CNT, 7),
      State = case_when(
        CODE == "AUS" ~ "All States",
        TRUE ~ auStates[CODE]
      ),
      State = factor(State, levels = ausPops$State)
    ) %>% 
    ungroup() %>%
    mutate(MA7 = round(MA7, 2)) %>% 
    dplyr::rename(
      Date = REPORT_DATE, Hospitalisations = MED_HOSP_CNT, `7 Day Average` = MA7
    ) %>% 
    ggplot(aes(Date, colour = State)) + 
    geom_point(aes(y = Hospitalisations), alpha = 0.5, colour = "grey", size = 1/2) +
    geom_segment(
      aes(xend = Date, y = 0, yend = Hospitalisations),
      colour = "grey", alpha = 0.5
    ) +
    geom_line(aes(y = `7 Day Average`)) +
    facet_wrap(~State, scales = "free_y", ncol = 1) +
    coord_cartesian(xlim = c(dt - 365/4, dt)) +
    scale_color_manual(
      values = c(hcl.colors(length(ausPops$State) - 1, "Dark 3"), "black")
    ) +
    labs(x = "Date", y = "Hospitalisations") +
    theme(legend.position = "none")
)

Plot of daily new hospitalisations for the last year. Coloured lines represent 7 day averages.

Hospitalisation Rate

plotly::ggplotly(
data %>% 
  dplyr::select(
    date = REPORT_DATE, CODE, State = NAME, active = ACTIVE_CNT,
    hosp = MED_HOSP_CNT, new = NEW_CASE_CNT
  ) %>% 
  arrange(State, date) %>% 
  group_by(State) %>% 
  mutate(
    total = sma(new, 7) * 7,
    p_hosp = hosp / lag(total, 7),
    ma = sma(p_hosp, 7),
    State = case_when(
      CODE == "AUS" ~ "All States",
      TRUE ~ auStates[CODE]
    ),
    State = factor(State, levels = ausPops$State),
    `Hospitalisation Rate` = percent(p_hosp, accuracy = 0.01)
  ) %>% 
  ungroup() %>% 
  # dplyr::filter(year(date) >= 2022) %>% 
  dplyr::filter(date > today() - 122, p_hosp > 0) %>% 
  dplyr::rename(Date = date, `In Hospital` = hosp) %>% 
  ggplot(
    aes(Date, p_hosp, colour = State, label = `Hospitalisation Rate`, key = `In Hospital`)
  ) +
  geom_line()  +
  facet_wrap(~fct_rev(State), scales = "free_y") +
  scale_color_manual(
      values = c(hcl.colors(length(ausPops$State) - 1, "Dark 3"), "black")
  ) +
  scale_y_continuous(labels = percent) +
  theme(legend.position = "none") +
  labs(y = "Hospitalisation Rate"),
 tooltip = c("State", "Date", "In Hospital", "Hospitalisation Rate")
)

Hospitalisation rate using the 7-day total number of new cases to represent active cases, and projecting hospitalisations back onto the total active case estimates from 1 week prior. High hospitalisation rates may indicate under-reporting of cases, or a more severe phase of the pandemic. Data is only shown for the last 4 months.

Fatalities

plotly::ggplotly(
  data %>% 
    dplyr::filter(REPORT_DATE <= dt, CASE_CNT > 0) %>% 
    arrange(CODE, REPORT_DATE) %>% 
    mutate(
      `Daily Fatalities` = DEATH_CNT - PREV_DEATH_CNT,
      `Daily Fatalities` = ifelse(is.na(`Daily Fatalities`), 0, `Daily Fatalities`)
    ) %>%
    # dplyr::select(REPORT_DATE, CODE, DEATH_CNT, CASE_CNT) %>% 
    group_by(CODE) %>% 
    mutate(
      MA7 = sma(`Daily Fatalities`, 7),
      State = case_when(
        CODE == "AUS" ~ "All States",
        TRUE ~ auStates[CODE]
      ),
      State = factor(State, levels = ausPops$State),
      `Cumulative Total` = comma(DEATH_CNT, 1)
    ) %>% 
    ungroup() %>%
    mutate(MA7 = round(MA7, 2)) %>% 
    dplyr::rename(
      Date = REPORT_DATE, `7 Day Average` = MA7
    ) %>% 
    ggplot(aes(Date, colour = State, label = `Cumulative Total`)) + 
    geom_point(aes(y = `Daily Fatalities`), alpha = 0.5, colour = "grey", size = 1/2) +
    geom_segment(
      aes(xend = Date, y = 0, yend = `Daily Fatalities`),
      colour = "grey", alpha = 0.5
    ) +
    geom_line(aes(y = `7 Day Average`)) +
    facet_wrap(~State, scales = "free_y", ncol = 1) +
    coord_cartesian(xlim = c(dt - 365/4, dt)) +
    scale_color_manual(
      values = c(hcl.colors(length(ausPops$State) - 1, "Dark 3"), "black")
    ) +
    labs(x = "Date", y = "Daily Fatalities") +
    theme(legend.position = "none")
)

Plot of daily fatalities for the last year. Coloured lines represent 7 day averages.

Monthly Fatalities

plotly::ggplotly(
  data %>% 
    mutate(
      year = year(REPORT_DATE),
      month = month.abb[month(REPORT_DATE)],
      month = factor(month, levels = month.abb),
      week = week(REPORT_DATE),
      daily_deaths = DEATH_CNT - PREV_DEATH_CNT
    ) %>% 
    arrange(month, year) %>% 
    group_by(year, month, CODE, NAME) %>% 
    summarise(
      Total = sum(daily_deaths, na.rm = TRUE),
      .groups = "drop"
    ) %>% 
    mutate(
      Date = paste(month, year, sep = "-") %>% fct_inorder(),
      State = case_when(
        CODE == "AUS" ~ "All States",
        TRUE ~ auStates[CODE]
      ),
      State = factor(State, levels = ausPops$State)
    ) %>% 
    ggplot(aes(Date, Total, fill = State)) +
    geom_col(
      aes(Date, Total),
      data = . %>% 
        dplyr::filter(CODE == "AUS"),
      colour = "black",
      inherit.aes = FALSE
    ) +
    geom_col(
      data = . %>% 
        dplyr::filter(CODE != "AUS"),
    ) +
    scale_y_continuous(expand = expansion(c(0, 0.05))) +
    scale_fill_manual(
      values = hcl.colors(length(ausPops$State) - 1, "Dark 3")
    ) +
    labs(x = "Month", y = "Total Fatalities") +
    theme(
      axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)
    )
)

Monthly Fatalities throughout the course of the pandemic.

Weekly Fatalities

weekly_df <- data %>% 
    mutate(
      year = year(REPORT_DATE),
      month = month.abb[month(REPORT_DATE)],
      month = factor(month, levels = month.abb),
      week = week(REPORT_DATE),
      daily_deaths = DEATH_CNT - PREV_DEATH_CNT
    ) %>% 
    group_by(year, week, CODE, NAME)  %>% 
    summarise(
      Total = sum(daily_deaths, na.rm = TRUE),
      Date = max(REPORT_DATE),
      .groups = "drop"
    ) %>% 
    mutate(
      State = case_when(
        CODE == "AUS" ~ "All States",
        TRUE ~ auStates[CODE]
      ),
      State = factor(State, levels = ausPops$State)
      
    ) %>% 
    dplyr::filter(Date > ymd("2021-07-01"))
plotly::ggplotly(
   weekly_df %>% 
     dplyr::filter(Date <= today()) %>% 
    ggplot(aes(Date, Total, fill = State)) +
    geom_col(
      aes(Date, Total),
      data = . %>% 
        dplyr::filter(CODE == "AUS"),
      colour = "black",
      inherit.aes = FALSE,
      width = 3
    ) +
    geom_col(
      data = . %>% 
        dplyr::filter(CODE != "AUS"),
      width = 3
    ) +
     geom_hline(yintercept = 269, linetype = 2, col = "grey30") +
     geom_hline(yintercept = 416, col = "grey30") +
    scale_y_continuous(expand = expansion(c(0, 0.05))) +
    scale_fill_manual(
      values = hcl.colors(length(ausPops$State) - 1, "Dark 3")
    ) +
    labs(x = "Month", y = "Weekly Fatalities") +
    theme(
      axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)
    )
)

Weekly Fatalities since 1-July, 2021. Horizontal lines indicate the capacity of a 767 and 747-400 respectively.

2020 Fatalities: Population Scaled

ggplotly(
  weekly_df %>% 
    left_join(ausPops, by = "State") %>% 
    dplyr::filter(Date > "2021-07-01") %>%
    group_by(State) %>% 
    mutate(
      Total = cumsum(Total),
      Rate = round(1e6 * Total / Population, 2),
      Total = comma(Total)
    ) %>% 
    ungroup() %>% 
    mutate(State = factor(State, levels = ausPops$State)) %>% 
    ggplot(
      aes(Date, Rate, colour = State, label = Total)
    ) +
    geom_line() +
    scale_colour_manual(
      values = c(hcl.colors(length(ausPops$State) - 1, "Dark 3"), "black")
    ) +
    labs(x = "Date", y = "Total Deaths / Million"),
  tooltip = c("State", "Date", "Rate", "Total")
)

State-level Fatalities scaled by estimated population, starting at 1-July-2021 as an approximate start date for the Australian pandemic. A value of 500 on the y-axis indicates that 1 in every 2000 people has died.

Wave Momentum

plotly::ggplotly(
  momentum_df %>% 
    # dplyr::filter(Date > dt - 150) %>% 
    dplyr::filter(Date > dt - 60) %>% 
    ggplot(
      aes(Date, short_ma, colour = State, label = Status)
    ) +
    geom_line() +
    geom_line(aes(y = long_ma), colour = "grey30", linetype = 3) +
    geom_point(
      aes(x = Date, y = short_ma),
      data = . %>% 
        inner_join(terms, by = c("State" = "State", "Date" = "Start")),
      shape = 17, colour = "darkgreen", size = 2
    ) +
    geom_point(
      aes(x = Date, y = short_ma),
      data = . %>% 
        inner_join(terms, by = c("State" = "State", "Date" = "End")),
      shape = 19, colour = "red", size = 2
    ) +
    geom_hline(yintercept = 0) +
    facet_wrap(~State) +#, scales = "free") +
    scale_color_manual(
    values = c(hcl.colors(length(ausPops$State) - 1, "Dark 3"), "black")
    ) +
    labs(
      x = "Date", 
      y = "Smoothed log2 Weekly Change"
    ) 
)

Wave momentum as calculated by dividing each day’s value by the same day one week ago, then log2₂ transforming and smoothing with 3 and 7-day moving averages. Each unit on the y-axis indicates a doubling or halving of cases. When the 7-day smoothed average (black line) is above zero, a wave is likely to be underway with a wave receding when below zero. Final school-term dates are shown as red dots, whilst the start date of school terms is shown as a green triangle

The current wave status for each state is:

R Session Information

R version 4.2.1 (2022-06-23)

Platform: x86_64-pc-linux-gnu (64-bit)

locale: LC_CTYPE=en_AU.UTF-8, LC_NUMERIC=C, LC_TIME=en_AU.UTF-8, LC_COLLATE=en_AU.UTF-8, LC_MONETARY=en_AU.UTF-8, LC_MESSAGES=en_AU.UTF-8, LC_PAPER=en_AU.UTF-8, LC_NAME=C, LC_ADDRESS=C, LC_TELEPHONE=C, LC_MEASUREMENT=en_AU.UTF-8 and LC_IDENTIFICATION=C

attached base packages: stats, graphics, grDevices, utils, datasets, methods and base

other attached packages: Rcpp(v.1.0.9), htmltools(v.0.5.3), reactable(v.0.3.0), jsonlite(v.1.8.0), httr(v.1.4.3), plotly(v.4.10.0), pander(v.0.6.5), rvest(v.1.0.2), glue(v.1.6.2), ggrepel(v.0.9.1), scales(v.1.2.0), lubridate(v.1.8.0), rlang(v.1.0.4), forcats(v.0.5.1), stringr(v.1.4.0), dplyr(v.1.0.9), purrr(v.0.3.4), readr(v.2.1.2), tidyr(v.1.2.0), tibble(v.3.1.8), ggplot2(v.3.3.6) and tidyverse(v.1.3.2)

loaded via a namespace (and not attached): assertthat(v.0.2.1), digest(v.0.6.29), utf8(v.1.2.2), reactR(v.0.4.4), R6(v.2.5.1), cellranger(v.1.1.0), backports(v.1.4.1), reprex(v.2.0.1), evaluate(v.0.15), highr(v.0.9), pillar(v.1.8.0), curl(v.4.3.2), lazyeval(v.0.2.2), googlesheets4(v.1.0.0), readxl(v.1.4.0), data.table(v.1.14.2), rstudioapi(v.0.13), jquerylib(v.0.1.4), rmarkdown(v.2.14), labeling(v.0.4.2), googledrive(v.2.0.0), htmlwidgets(v.1.5.4), munsell(v.0.5.0), broom(v.1.0.0), compiler(v.4.2.1), modelr(v.0.1.8), xfun(v.0.31), pkgconfig(v.2.0.3), tidyselect(v.1.1.2), viridisLite(v.0.4.0), fansi(v.1.0.3), crayon(v.1.5.1), tzdb(v.0.3.0), dbplyr(v.2.2.1), withr(v.2.5.0), grid(v.4.2.1), gtable(v.0.3.0), lifecycle(v.1.0.1), DBI(v.1.1.3), magrittr(v.2.0.3), cli(v.3.3.0), stringi(v.1.7.8), cachem(v.1.0.6), farver(v.2.1.1), fs(v.1.5.2), xml2(v.1.3.3), bslib(v.0.4.0), ellipsis(v.0.3.2), generics(v.0.1.3), vctrs(v.0.4.1), tools(v.4.2.1), crosstalk(v.1.2.0), hms(v.1.1.1), fastmap(v.1.1.0), yaml(v.2.3.5), colorspace(v.2.0-3), gargle(v.1.2.0), knitr(v.1.39), haven(v.2.5.0) and sass(v.0.4.2)